;;########################################################################
;; modelobj.lsp
;; define model-object-proto inheriting from mv-data-object-proto
;; Copyright (c) 1991-2002  by Forrest W. Young
;;########################################################################

(defproto model-object-proto 
  '(save-menu-item create-menu-item visualize-menu-item 
   report-menu-item model-abbrev dialog data-object transf-obj?
    hide-analysis-icon hide-model-icon dialog-objid
;;following slots added for plug-in capability
   data-types analyze-menu-item-name button-name ok-variable-types) ()
  mv-data-object-proto )

(defmeth model-object-proto :isnew 
                   (data-list variables types labels freq data-type
                    freq-way-names array tool-id data-obj title 
                    name dialog &optional (ok-types '(numeric)));fwy4.28
  (let ((tool-names (mapcar #'(lambda (tool) (send tool :title))
                            (send *toolbox* :icon-list)))
        (extended-tool-names (mapcar #'(lambda (tool) (send tool :title))
                            (send *toolbox* :extended-icon-list)))
        (extended-tool)
        (reanalysis-icon-number)
        (tool-number tool-id)
        (tool-objid)
        (reanalysis (send *workmap* :reanalysis?))
        (start-time (get-internal-real-time))
        (elapsed) (start-dialog)
        (dash? title) 
        )
   ; (unless (or (send self :hide-model-icon)
   ;             (send self :hide-analysis-icon))
   ;         (format t "; Method: ~a; ~a~%> " 
   ;                 (send self :proto-name) TITLE))
    (unless (send self :statobj-start-time) 
            (send self :statobj-start-time (get-internal-real-time)))
    ;(FORMAT T "; MODELOBJ.LSP|ISNEW: DATA-LIST ~A DATA-OBJ ~A" DATA-LIST DATA-OBJ)
    (send *workmap* :reanalysis? nil)
    (setf tool-number (position tool-id tool-names :test #'equal))
    (when (not tool-number)
          (setf extended-tool t)
          (setf tool-number (position tool-id extended-tool-names :test #'equal))
          (when (not tool-number)
                (setf tool-number (send *toolbox* :make-new-tool tool-id))))
    (if (not (eq current-object data-obj)) (setcd data-obj))
    (send self :statistical-object-type 
          (if (send self :transf-obj?) "transf" "model"))
    (cond 
      ((send self :hide-analysis-icon)
       (setf name "hidden")
       )
      ((send self :transf-obj?)
       (send self :make-names (string-capitalize (send self :model-abbrev))))
      (t
       (setf name (string-capitalize (send data-obj :name)))
       (send self :make-names name (string-capitalize (send self :model-abbrev)))))
    (send self :analyze-menu-item-name title)
    (send self :button-name tool-id)
    (send self :title title)
    ;(ONE-BUTTON-DIALOG "MODEL-OBJ B4 CALLNEXTMETHOD TO DATA-OBJ")
    (call-next-method data-list variables title labels types name 
                      freq data-type (first freq-way-names)
                      (second freq-way-names) array);args added fwy 5.2.9
#|    
   ;(format t "~%; MODELOBJ.LSP|ISNEW~%title ~a~%name ~a~%full-name ~a~%tool-id ~a" 
   ;(SEND SELF :TITLE) (SEND SELF :NAME) (send self :full-name) tool-id )
  
(print (list "modelobj.lsp|isnew reanalysis " reanalysis "hidden analysis " (send self :hide-analysis-icon) "dash-icon " (send self :dash-icon) "transf " (send self :transf-obj?)))
 |#

    ;(ONE-BUTTON-DIALOG "MODEL-OBJ AFTER CALL TO DATA-OBJ, B4 MAKING ICON")
    (cond 
      (reanalysis
       (setf reanalysis-tool-objid (first reanalysis))
       (setf reanalysis-icon-number (second reanalysis))
       (setf tool-objid reanalysis-tool-objid)
       (setca (send tool-objid :object) reanalysis-icon-number)) 
      ((send self :hide-analysis-icon)
       )
      ((send self :dash-icon)
       (send self :icon-title (send self :proper-name));was propername
       (send self :analyze-menu-item-name "DataSheet Editor")
       (setf tool-objid
             (send *workmap* :add-connected-icon 
                   (send *workmap* :selected-icon) 
                   name
                   9
                   (send current-transf :determine-data-type)
                   :object current-transf))
       (send tool-objid :object self)
       (send tool-objid :analyze-menu-item-name title)
       )
      (t
;copy-tool-icon returns wrong object id. returns objid of original
;not of copy.  I hack it here rather than there. The hack is
;the second line below. fwy july 2002
       (setf tool-objid (send *toolbox* :copy-tool-icon tool-number))
       (setf tool-objid (send *workmap* :selected-icon-object))
       (send self :icon-title (send self :proper-name));was propername

       (send tool-objid :object self)
       (send tool-objid :analyze-menu-item-name  title)
       ))
    (when (send *vista* :guidemap) (setf dialog t));fwy4.28
    (send self :data-object data-obj);added here. was below ; fwy 5.2.9
    (send self :icon-number (send *workmap* :selected-icon))

    ;(ONE-BUTTON-DIALOG "MODEL-OBJ B4 DIALOG")

    (send self :dialog dialog)
    (let ((transf-obj? (send self :transf-obj?)) 
          (analysis-name)
          (go-for-it))
      (setf method 
            (if transf-obj? 
                (send self :name)
                (blanks-to-dashes 	
                 (string-downcase 
                  (select 
                   (send *toolbox* :analyze-menu-item-name-master)
                   tool-number)))))
      
      (send self :elapsed-time
            (/ (- (get-internal-real-time) (send self :statobj-start-time))
               internal-time-units-per-second))
      (setf go-for-it (send self :options))
      (send self :statobj-start-time (get-internal-real-time))
      (when (and go-for-it (not (send self :hide-model-icon)))
	(send (send *workmap* :selected-icon-object) :analysis 
	 (send self :analyze-menu-item-name)))
      (when (and (send self :dialog) (not go-for-it) transf-obj?)
            ;lastterm isa transf
            (when (not transf-obj?) (send *toolbox* :reset-button tool-number))
            (setcd data-obj)
            (send *workmap* :redraw))
      (when (or (not (send self :dialog)) go-for-it)
            (send self :analysis)
            (send self :elapsed-time 
                  (+ (send self :elapsed-time)
                     (/ (- (get-internal-real-time) (send self :statobj-start-time))
                        internal-time-units-per-second)))
            (send self :instance-info
                  (format nil ";         Instantiated: ~a; Elapsed: ~,3d Seconds (without dialog);" 
                          (select (date-time) 9)
                          (fuzz (send self :elapsed-time) 3)))
            (send self :icon-title name)
            (setf start (get-internal-real-time))

           ; (ONE-BUTTON-DIALOG "MODEL-OBJ ANALYSIS DONE")

            (unless (send self :hide-model-icon)
                    (send self :new-object)
                    (send self :info)
                    (when reanalysis 
                          (setca (send tool-objid :object)
                                 reanalysis-icon-number)) )

            (unless (or transf-obj? (send self :hide-model-icon)) 
                    (when (and (not (send *vista* :guidemap)) (not transf-obj?)) 
                          (setcm self))
                    

                    (when *autoshow-model-visuals*
                          (setf start (get-internal-real-time))
                          (setf vis (visualize-model))
                          (setf elapsed (/ (- (get-internal-real-time) start)
                             internal-time-units-per-second))
                          )
                    (when *autoshow-model-reports* 
                          (setf start (get-internal-real-time))
                          (report-model)
                          (setf elapsed (/ (- (get-internal-real-time) start)
                                           internal-time-units-per-second))
                          )
                    )
            
            self))))

(defmeth model-object-proto :analysis-icon ()
    (select (send *workmap* :icon-list) (- (send self :icon-number) 2)))

(defmeth model-object-proto :analysis-summary ()
  (setcm (send (send *workmap* :selected-icon-object) :analysis))
  (send *cm* :options))

(defmeth model-object-proto :timed-analysis (model-string)
  (send self :analysis)
  (format t "; ~a: " model-string))

(defmeth model-object-proto :new-object ()
  (setf current-model self)
  (setf *current-model* self)
  (setf current-object self)
  (setf *current-object* self)
  (send *vista* :stats-menus-on)
  (send *model-menu* :enabled t)
  (send (send *vista* :var-window-object) :clear)
  (send (send *vista* :obs-window-object) :clear)
  ;(send self :add-model-menu-item (send self :model-abbrev))
  (send self :iconize)
  (send self :icon-number (length (send *workmap* :icon-list)))
  )

(defmeth model-object-proto :save-menu-item 
  (&optional (state nil set))
    (if set (setf (slot-value 'save-menu-item) state))
    (slot-value 'save-menu-item))

(defmeth model-object-proto :create-menu-item 
  (&optional (state nil set))
    (if set (setf (slot-value 'create-menu-item) state))
    (slot-value 'create-menu-item))

(defmeth model-object-proto :visualize-menu-item 
  (&optional (state nil set))
    (if set (setf (slot-value 'visualize-menu-item) state))
    (slot-value 'visualize-menu-item))

(defmeth model-object-proto :report-menu-item 
  (&optional (state nil set))
    (if set (setf (slot-value 'report-menu-item) state))
    (slot-value 'report-menu-item))

(defmeth model-object-proto :model-abbrev 
  (&optional (state nil set))
    (if set (setf (slot-value 'model-abbrev) state))
    (slot-value 'model-abbrev))

(defmeth model-object-proto :dialog (&optional (value nil set))
    (if set (setf (slot-value  'dialog) value))
    (slot-value 'dialog))

(defmeth model-object-proto :dialog-objid (&optional (objid nil set))
    (if set (setf (slot-value  'dialog-objid) objid))
    (slot-value 'dialog-objid))

(defmeth model-object-proto :data-object (&optional (object-id nil set))
    (if set (setf (slot-value  'data-object) object-id))
    (slot-value 'data-object))

(defmeth model-object-proto :transf-obj? (&optional (logical nil set))
    (if set (setf (slot-value  'transf-obj?) logical))
    (slot-value 'transf-obj?))

(defmeth model-object-proto :data-types (&optional (list nil set))
    (if set (setf (slot-value 'data-types) list))
    (slot-value 'data-types))

(defmeth model-object-proto :ok-variable-types (&optional (list nil set))
    (if set (setf (slot-value 'ok-variable-types) list))
    (slot-value 'ok-variable-types))

(defmeth model-object-proto :analyze-menu-item-name
  (&optional (string nil set))
    (if set (setf (slot-value 'analyze-menu-item-name) string))
    (slot-value 'analyze-menu-item-name))

(defmeth model-object-proto :button-name 
  (&optional (string nil set))
    (if set (setf (slot-value 'button-name) string))
    (slot-value 'button-name))

(defmeth model-object-proto :hide-analysis-icon (&optional (logical nil set))
    (if set (setf (slot-value  'hide-analysis-icon) logical))
    (slot-value 'hide-analysis-icon))

(defmeth model-object-proto :hide-model-icon (&optional (logical nil set))
    (if set (setf (slot-value  'hide-model-icon) logical))
    (slot-value 'hide-model-icon))

(defmeth model-object-proto :statistical-object-type (&optional (logical nil set))
;written this way to prevent changing it to invalid value
    (setf (slot-value 'statistical-object-type) "model")
    (slot-value 'statistical-object-type))
  
(defmeth model-object-proto :visualize (&key dialog tour freq)
"Alias for VISUALIZE-DATA and VISUALIZE-MODEL"
  (send self :visualize-model :dialog dialog)
  ;(vista-message "No Visualization written for this model.")
  )

(defmeth model-object-proto :visualize-statistical-object (&key dialog tour freq)
"Args: (dialog nil)
Generic method used for both data and model objects by toolbar visualize button."
  (send current-model :visualize-model :dialog dialog))

(defun visualize-model (&key dialog)
"Args: (dialog nil)
Generic function for (send current-model :visualize-model)"
  (send current-model :visualize-model :dialog dialog))

(defmeth model-object-proto :visualize-model (&key dialog)
"Function Args: (dialog nil)
Presents a spreadplot visualization of the current model. When dialog is t and if spreadplots of this model have already been seen, asks if the user wishes to see an old one or make a new one. Used by menu and workmap systems."
  (if (not (eq current-object self)) (setcm self))
  (let (
        #-containers(result (if dialog (send self :update-sp-list) 0))
        #+containers(result 0)
        (icon (select (send *workmap* :icon-list) 
                      (1- (send current-model :icon-number)))))
    (send *workmap* :stop-screen-saver)
    (send icon :do-click "graph")
    (when result
          (cond
            ((> result 0)
             #-containers(send (select (send self :spreadplots) (1- result)) 
                               :show-spreadplot)
            ; next statement works, but only if splot minimized, not closed
             #+containers(send (send (select (send self :spreadplots) (1- result))
                                     :container) :show-window)
             )
            (t
             (send *watcher* :show-window)
             (send *watcher* :write-text 
                   (format nil "Creating Visualization"))
             (if (equal (send self :model-abbrev) "REG")
                 (setf *spreadplot-container* *regres-spreadplot-container*)
                 (setf *spreadplot-container* 
                       (send self :create-spreadplot-container) ))
             (send current-model :visualize)
             (disable-container)
             (send *watcher* :hide-window)))
          (when (> result 0)
                (send self :spreadplots 
                      (add-element-to-list 
                       (send self :spreadplots) 
                       *current-spreadplot*)))
          )
    (send icon :do-click)
    (send *workmap* :reset-screen-saver)
    *spreadplot-container*))

(defmeth model-object-proto :update-sp-list ()
  (let ((sp-list (remove-if #'null (send self :spreadplots)))
        (sp-titles) 
        (result -1))
    (when sp-list
          (setf sp-titles 
                (mapcar #'(lambda (sp) 
                            (when (send sp :title)
                                  (strcat "Previous " (send sp :title))))
                        sp-list))
          (setf sp-titles (remove-if #'null sp-titles))
          (when sp-titles
                (setf result (choose-item-dialog "Which Visualization?"
                        (combine "Create A New Visualization" sp-titles)))))
    result))



(defun report (&key dialog)
"Args: none
Makes a numeric report of the current object."
  (when current-object (send current-object :report :dialog dialog)))

(defun report-model (&key dialog) 
"Args: (&key (dialog nil))
Makes a numeric report of the current model."
  (when current-model (send current-model :report-model :dialog dialog)))

(defmeth model-object-proto :report-model (&key dialog)
"Args: (&key (dialog nil))
Makes a numeric report of the current model."
  (when current-model
        (if (not (eq current-model self)) (setcm self))
        (let* ((w)
               (icon (select (send *workmap* :icon-list) 
                             (1- (send current-model :icon-number)))))
          (send *workmap* :stop-screen-saver)
          (send icon :do-click "stats")
          (setf w (send self :report :dialog dialog))
          (send icon :stats-icon-clicked-on nil)
          (send icon :stats-hilited nil)
          (send icon :draw-stats-icon)
          (send *workmap* :reset-screen-saver)
          w))
  )

(defmeth model-object-proto :summarize (&key dialog)
  (when current-model (send self :report-model :dialog dialog))
  t)

(defmeth model-object-proto :report (&rest args)
  (vista-message "No report method written for this model.")
  nil)

(defmeth  model-object-proto :add-model-menu-item (model-abbrev)
  (error "; using add-model-menu-item method. replaced by iconize method"))

(defmeth model-object-proto :iconize ()
  (let* ((object current-model)
         (current-menu-length (length (send (eval *model-menu*) :items)))
         ;(menu-name (send self :icon-title))
         (menu-name (send self :proper-name))
         (selected-icon (send *desktop* :selected-icon))
         (current-model-icon-objid nil)
         )
    (send self :icon-title menu-name)
    (send object :add-parent current-data)
    (send current-data :add-child object)
    (send *desktop* :add-connected-icon selected-icon menu-name 3 nil :object object)
    (set (intern (string-upcase menu-name)) current-model)
    (set (intern (string-upcase (send self :name))) current-model)
    (setf current-model-icon-objid
          (first (last (send *workmap* :model-icon-list))))
    (send current-model-icon-objid :object object)
    (cond ((send *vista* :long-menus)
           (send object :menu-length current-menu-length)
           (send *desktop* :no-menu-marks *model-menu*)
           (let ((item (send menu-item-proto :new menu-name :mark t
                             :action #'(lambda () (set-current-model object)))))
             (send *model-menu* :append-items item)
             (send item :add-slot 'object object)
             (defmeth item :object (&optional (obj-id nil set)) 
               (if set (setf (slot-value 'object) obj-id))
               (slot-value 'object))
             ))
      (t (send object :menu-length 
               (+ current-menu-length
                  (length (send *workmap* :model-icon-list))))))
    (setf current-model-menu-item-number current-menu-length)
    (when (send *vista* :guidemap) (setcd current-data))
    ))


(defun @   (&optional (sob @)) (setco sob) sob)

(defun use (&optional (sob @)) (setco sob) sob)

(defun sob-type (&optional (sob @)) (send sob :statistical-object-type))

(defun setco (stat-object)
  (cond 
;data=mv-data-object-proto 
    ((equal (send stat-object :statistical-object-type) "data")   (setcd  stat-object))
;diss=diss-data-object-proto 
    ((equal (send stat-object :statistical-object-type) "diss")   (setcd  stat-object))
;dash=datasheet-proto 
;dash=data-supervisor-proto
;dash=diss-data-supervisor-proto
    ((equal (send stat-object :statistical-object-type) "dash")   (setcds stat-object))
;transf=transf-object-proto 
    ((equal (send stat-object :statistical-object-type) "transf") (setct  stat-object))
;analy=UNDEFINED
    ((equal (send stat-object :statistical-object-type) "analy")  (setca  stat-object))
;model=model-object-proto 
    ((equal (send stat-object :statistical-object-type) "model")  (setcm  stat-object))
;plugin=UNDEFINED
    ((equal (send stat-object :statistical-object-type) "plugin") (setplg  stat-object))
;report=UNDEFINED
    ((equal (send stat-object :statistical-object-type) "report") (setcr  stat-object))
;graph=UNDEFINED
    ((equal (send stat-object :statistical-object-type) "graph")  (setcg  stat-object))
;splot=UNDEFINED
    ((equal (send stat-object :statistical-object-type) "splot")  (setcsp stat-object))
    (t (error "unknown statistical object type"))))

(defun setcm (object) (set-current-model object))

(defun set-current-model (object)
  (let* ((menu-length (send object :menu-length))
         (long-menus (send *vista* :long-menus))
         (current-icon nil))
    (when (not long-menus) (setf menu-length (1- menu-length)))
    (setf current-model  object)
    (setf current-object object)
    (unless 
     (send object :hide-model-icon)
    ; (unless (send *workmap* :reanalysis?)
    ;         (setf current-icon 
    ;               (select (send *workmap* :model-icon-number-list)
    ;                       (- menu-length (send *workmap* :num-model-menu-items)))))
     (send delete-model-menu-item :enabled t)
     (send delete-data-menu-item :enabled nil)
     (setf *current-model* object)
     (setf *cm* object)
     (setf *current-object* object)
     (setf *co* object)
     (setf $$ *current-model*)
     (setf @ object)
     ;(defmeth @ :print (&rest args)
     ;  (format t "~a" (intern (string-upcase (send self :full-name)))))
     ;(defmeth $$ :print (&rest args)
     ;  (format t "~a" (intern (string-upcase (send self :full-name)))))
     (send *workmap* :initialize-model-menu)
     (send *toolbox* :set-two-buttons t t)
     ;(send *workmap* :select-icon current-icon)
     (send *toolbox* :set-three-buttons)
     (send *vista* :stats-menus-on)
     (send *model-menu* :enabled t)
     (send (send *vista* :var-window-object) :clear)
     (send (send *vista* :obs-window-object) :clear)
     (cond 
       ((equal "uni" (string-downcase (send current-model :model-abbrev)))
        ;(send create-dataobjects-model-popup-menu-item :enabled nil)
        (send create-dataobjects-model-menu-item :enabled nil))
       (t
        ;(send create-dataobjects-model-popup-menu-item :enabled t)
        (send create-dataobjects-model-menu-item :enabled t)))
     (when long-menus
           (send *workmap* :no-menu-marks *model-menu*)
           (send (select (send *model-menu* :items) menu-length) :mark t))
     (when (send *vista* :guidemap) 
           (when investigate 
                 (format t "Calling Guidance from SETCModel."))
           (guidance "model")))
   (send *workmap* :current-object-line
          (list (if dfn (strcat "FileName: " dfn) "FileName: UNSAVED ViSta Model Object") 
	(strcat "DataFlow: " (send $ :dataflow-name))))
    object))
  
(setf *current-model* nil)

(defun save-model (&optional name)
"Args: (&optional name)
Saves the current model to a file named NAME"
  (cond 
    ((not *user-path*)
     (message-dialog (format nil "Sorry. No User Directory.~%You cannot save models.")))
    (t
     (if name (send current-model :save-model name)
         (send current-model :save-model)))))

(defmeth model-object-proto :save-model (&optional file)
"Args: (&optional file)
FILE is a string. The model-object is written to the file FILE.lsp in a form suitable for use with the load-model command.  The template for this form
is supplied by the specific model object by a save-model-template method."
  (when (not (eq current-object self)) (setcm self))
  (let* ((name (send current-model :name))
         (L (min 8 (length name)))
         (suggest (strcat (subseq name 0 L) ".lsp")))
    (if (not (set-working-directory *user-dir-name*))
              (set-working-directory "C:\\windows\\desktop"))
    (when (not file) 
            (setf file 
#+macintosh (set-file-dialog  "Save Model as File:" suggest t)
#+msdos     (set-file-dialog  "Save Model as File:" suggest)
#+X11       (file-save-dialog "Save Model as File:" "*.lsp" ".")
                           ))
    (when file
          (setf file (string-downcase-if-not-X11 file))
          (when (and (> (length file) 3)
                     (string= ".lsp" file
                              :start2 (- (length file) 4)))
                (setf file (string-right-trim "lsp" 
                              (string-downcase-if-not-X11 file)))
                (setf file (string-right-trim "." file)))
          (format t "; saving ~s~%" file)
          (let ((f (open (strcat (string file) ".lsp") :direction :output))
                (data-object (send self :data-object))
                (oldbreak *breakenable*))
            (setq *breakenable* nil)
            (unwind-protect 
             (print (send self :save-model-template data-object) f))
            (setq *breakenable* oldbreak)
            (close f)
            (format t "; finished saving ~s~%" file)
            f))))

(defmeth model-object-proto :create-input-data-object 
  (model-abbrev creator)
  (data  (concatenate 'string "Input-" (send self :name))
   :title (concatenate 'string model-abbrev (send self :title))
   :created creator
   :creator-object self
   :labels (send self :labels)
   :data (send self :data)
   :variables (send self :variables)
   :types (send self :types))
  )

(defmeth model-object-proto :analysis-summary (window &optional (flush t))
"Args: WINDOW &OPTIONAL (FLUSH T)
Displays information about the choosen options and the details of the analysis in WINDOW, optionally FLUSHing the window first. Used by REPORT for header information, and by ABOUT-THIS-MODEL for analysis summary information."
  (when flush (send window :flush-window))
  (send window :paste-string 
        "Information about analysis options is not available."))

(defmeth model-object-proto :interpret-model (&optional (flush t))
"Args: &OPTIONAL (FLUSH T)
Displays interpretation of the analysis in *ABOUT-WINDOW*, optionally FLUSHing the window first. Used by INTERPRET-MODEL and ABOUT-THIS-MODEL."
  (when flush (send *about-window* :flush-window))
  (send *about-window* :paste-string 
        "Interpretation is not available for this model"))

(defmeth model-object-proto :analysis-help (&optional (flush t) (window nil) (title nil))
  (let* ((items (send *analyze-menu* :items))
         (analysis-name (send self :analyze-menu-item-name))
         (names
          (mapcar #'(lambda (item) 
                      (select (send item :title) 
                              (iseq (- (length (send item :title)) 4))))
                  items))
         (item-index (first (which (map-elements #'equal analysis-name names))))
         (item (select items item-index))
         )
    (ignore-errors (send *workmap* :show-help item flush title t window))
    item))



(defun select-current-model-icon ()
  (send *desktop* :select-icon 
        (select (send *desktop* :model-icon-number-list)
                (- current-model-menu-item-number 7))))

(defmeth model-object-proto :use-new-tip (vector xvar yvar x y)
  (format t 
          "Moved Vector Tip ~g to x=~g on variable ~g, y=~g on variable ~g~%" 
          vector x xvar y yvar))

(defun load-model (&optional file)
"Args: (&optional file)
Loads a model object contained in a file.  The file's name must end with .lsp.
If the optional string argument FILE is included, the model object is loaded 
from FILE, otherwise a dialog is presented to select the file. The string 
need not end with .lsp.  Returns the object-id of the model object."
  (when (not file) 
        (setf file (open-file-dialog t)))
  (when file
        (let ((object (send *desktop* :load-object file))
              (previous-previous-data previous-data)
              )
          (cond ((objectp object)
                 (when (not previous-data)
                       (send *desktop* :initialize-data-menu)
                       (send *desktop* :initialize-model-menu)))
            (t (error "File does not contain an object.")
               (setf current-data previous-data)
               (setf previous-data previous-previous-data)))
          object)))


(defmeth model-object-proto :list-variables ()
"Args: none
Lists the variable names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-variables)
  t)

(defmeth model-object-proto :list-vars ()
"Args: none
Lists the variable names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-variables)
  t)

(defmeth model-object-proto :list-var ()
"Args: none
Lists the variable names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-variables)
  t)

(defmeth model-object-proto :list-observations ()
"Args: none
Lists the observations labels of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-observations)
  t)

(defmeth model-object-proto :list-obs ()
"Args: none
Lists the observations labels of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-observations)
  t)

(defmeth model-object-proto :list-matrices ()
"Args: none
Lists the matrix names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-matrices)
  t)

(defmeth model-object-proto :list-mats ()
"Args: none
Lists the matrix names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-matrices)
  t)

(defmeth model-object-proto :list-mat ()
"Args: none
Lists the matrix names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-matrices)
  t)

(defmeth model-object-proto :list-cells ()
"Args: none
Lists the cell names of the specified data object."
  (if (not (eq *current-data* self)) (setcd self))
  (send *vista* :list-cells)
  t)

(provide "modelobj")